home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / calendar.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-03-22  |  1.7 KB  |  57 lines
  1. 100  CLS:PRINT TAB(10);"PRINT A CALENDAR FOR ANY YEAR SINCE 1582":PRINT
  2. 110  '
  3. 120  ' Judson D. McClendon
  4. 130  ' 844 Sun Valley Road
  5. 140  ' Birmingham, AL 35215
  6. 150  '
  7. 160  ' Compuserve 74415,1003
  8. 170  '
  9. 200  DEF FNDOW(M,D,Y)=(D+M+M+INT((M+1)*0.6)+Y+Y\4-Y\100+Y\400+1) MOD 7
  10. 210  DIM MON$(12),MAX(12),DOM(12),DOW(12)
  11. 220  FOR I=1 TO 12 :READ MON$(I) :NEXT
  12. 230  DATA "   J A N U A R Y   ","  F E B R U A R Y  ","     M A R C H    "
  13. 240  DATA "     A P R I L     ","       M A Y       ","      J U N E     "
  14. 250  DATA "      J U L Y      ","    A U G U S T    "," S E P T E M B E R"
  15. 260  DATA "   O C T O B E R   ","  N O V E M B E R  ","  D E C E M B E R "
  16. 270  FOR I=1 TO 12 :READ MAX(I) :NEXT
  17. 280  DATA 31,28,31,30,31,30,31,31,30,31,30,31
  18. 300  INPUT "What year: ",YEAR
  19. 310  IF YEAR<100 THEN YEAR=YEAR+1900  ' Assume 20th century if not specified
  20. 320  IF YEAR<1582 THEN PRINT "Not valid before 1582" :GOTO 300
  21. 330  IF ((YEAR MOD 4)<>0) OR ((YEAR MOD 100)=0 AND (YEAR MOD 400)<>0) THEN 350
  22. 340  MAX(2)=29
  23. 350  PRINT :INPUT "How many copies";COPIES
  24. 400  FOR COUNT=1 TO COPIES
  25. 410    LPRINT :LPRINT
  26. 420    LPRINT TAB(27);"CALENDAR FOR THE YEAR";YEAR
  27. 430    LPRINT :LPRINT
  28. 500    FOR MM=1 TO 10 STEP 3
  29. 510      FOR MONTH=MM TO MM+2
  30. 520        LPRINT TAB((MONTH-MM)*24+6);MON$(MONTH);
  31. 530      NEXT
  32. 540      LPRINT :LPRINT
  33. 550      FOR MONTH=MM TO MM+2
  34. 560        LPRINT TAB((MONTH-MM)*24+6)"SU MO TU WE TH FR SA";
  35. 570        DAY=1 :GOSUB 900 :DOW(MONTH)=DOW :DOM(MONTH)=1
  36. 580      NEXT
  37. 590      LPRINT
  38. 600      FOR WEEK=1 TO 6
  39. 610        FOR MONTH=MM TO MM+2
  40. 630          WHILE DOM(MONTH)<=MAX(MONTH) AND DOW(MONTH)<7
  41. 640            LPRINT TAB((MONTH-MM)*24+DOW(MONTH)*3+6);"";
  42. 650            LPRINT USING "##";DOM(MONTH);
  43. 660            DOM(MONTH)=DOM(MONTH)+1
  44. 670            DOW(MONTH)=DOW(MONTH)+1
  45. 680          WEND
  46. 690          IF DOW(MONTH)>6 THEN DOW(MONTH)=0
  47. 700        NEXT
  48. 710        LPRINT
  49. 720      NEXT
  50. 730      LPRINT :LPRINT :LPRINT
  51. 740    NEXT
  52. 750    LPRINT CHR$(12);
  53. 760  NEXT
  54. 790  SYSTEM
  55. 900  IF MONTH<3 THEN DOW=FNDOW(MONTH+12,DAY,YEAR-1) ELSE DOW=FNDOW(MONTH,DAY,YEAR)
  56. 950  RETURN
  57.